home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_2526.txt < prev    next >
Text File  |  1990-04-17  |  8KB  |  258 lines
  1. -- card: 2526 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: WritePermission
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XFCN,WritePermission,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (button)
  14. -- low flags: 00
  15. -- high flags: A003
  16. -- rect: left=80 top=300 right=322 bottom=180
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 1
  20. -- font id: 0
  21. -- text size: 12
  22. -- style flags: 0
  23. -- line height: 16
  24. -- part name: Try It
  25. ----- HyperTalk script -----
  26. on mouseUp
  27.   get WritePermission(empty,true)
  28.   if it is "Cancel" then exit mouseUp
  29.   go to this card
  30.   if it then answer "That file is available for writing."
  31.   else answer "That file canΓÇÖt be opened for writing."
  32. end mouseUp
  33.  
  34.  
  35.  
  36. -- part 2 (button)
  37. -- low flags: 00
  38. -- high flags: A003
  39. -- rect: left=299 top=300 right=322 bottom=438
  40. -- title width / last selected line: 0
  41. -- icon id / first selected line: 0 / 0
  42. -- text alignment: 1
  43. -- font id: 0
  44. -- text size: 12
  45. -- style flags: 0
  46. -- line height: 16
  47. -- part name: Show Pascal Source
  48. ----- HyperTalk script -----
  49. on mouseUp
  50.   set the visible of card field 1 to not the visible of card field 1
  51.   if the visible of card field 1 is true then
  52.     set the name of me to "Hide Pascal Source"
  53.   else set the name of me to "Show Pascal Source"
  54. end mouseUp
  55.  
  56.  
  57.  
  58. -- part 3 (field)
  59. -- low flags: 81
  60. -- high flags: 2007
  61. -- rect: left=12 top=26 right=298 bottom=491
  62. -- title width / last selected line: 0
  63. -- icon id / first selected line: 0 / 0
  64. -- text alignment: 0
  65. -- font id: 22
  66. -- text size: 10
  67. -- style flags: 0
  68. -- line height: 13
  69. -- part name: Source
  70.  
  71.  
  72. -- part contents for background part 16
  73. ----- text -----
  74. WRITEPERMISSION XFCN version 1.1
  75. Kevin Calhoun
  76.  
  77. WritePermission determines whether an existing file can be opened for writing as well as reading.  It is intended for developers who need to know whether HyperCard can obtain write permission for a stack before the stack is opened.  This knowledge is especially useful in shared environments.
  78.  
  79. INVOKING WRITEPERMISSION
  80.  
  81. get WritePermission(<fullPathName>,<checkResourceForkAlso>)
  82.  
  83. returns:  true if file can be opened for writing, false otherwise
  84.  
  85. WritePermission takes two optional parameters, the full pathname of a file and a flag to tell WritePermission to check the resource fork as well as the data fork of the file.  If no pathname is supplied, WritePermission will display a standard file dialog, out of which the user can select a file about which to inquire.
  86.  
  87. If the second parameter is "false", WritePermission returns "true" if the data fork of the file can be opened for writing, "false" otherwise.  If the second parameter is "true", WritePermission returns "true" if both the data fork and the resource fork of the file can be opened for writing, "false" otherwise.
  88.  
  89. 2/20/90 version 1.1 works correctly with file servers.
  90.  
  91. -- part contents for card part 3
  92. ----- text -----
  93. UNIT SecretStuffAboutTheFileManager;
  94.  
  95. { XFCN WritePermission ┬⌐ 1989 by the Trustees of Dartmouth College }
  96. { Written by Kevin Calhoun }
  97.  
  98. { This source compatible with MPW Pascal 3.0 }
  99.  
  100. (*
  101. Pascal WritePermission.p
  102. Link -m ENTRYPOINT Γêé
  103.   -o "YourFile" Γêé
  104.   -rt XFCN=4125 Γêé
  105.   -sn Main=WritePermission Γêé
  106.   WritePermission.p.o Γêé
  107.   "{Libraries}"interface.o Γêé
  108.   "{PLibraries}"Paslib.o Γêé
  109.   "{Libraries}"HyperXLib.o
  110. *)
  111.  
  112. INTERFACE
  113.   USES
  114.     Types,
  115.     Resources,
  116.     Dialogs,
  117.     Packages,
  118.     Files,
  119.     ToolUtils,
  120.     HyperXCmd;
  121.   
  122.   PROCEDURE EntryPoint(paramPtr: XCMDPtr);
  123.   
  124. IMPLEMENTATION
  125.  
  126.   PROCEDURE WritePermission(paramPtr: XCMDPtr); FORWARD;
  127.   
  128.   PROCEDURE EntryPoint(paramPtr: XCMDPtr);
  129.   BEGIN
  130.     WritePermission(paramPtr);
  131.   END;
  132.   
  133.   FUNCTION GetScreenBitsBounds: Rect;
  134.   { get screenbits.bounds from the QuickDraw globals }
  135.   TYPE LongwordPtr = ^LONGINT;
  136.        BitMapPtr = ^BitMap;
  137.   CONST screenBitsOffset = -122;
  138.         CurrentA5 = $904;
  139.   VAR screenBitsPtr : BitMapPtr;
  140.       myLongwordPtr : LongwordPtr;
  141.   BEGIN
  142.     myLongwordPtr := LongwordPtr(CurrentA5);
  143.       { myLongwordPtr now points to the pointer to the first QD global }
  144.     myLongwordPtr := LongwordPtr(myLongwordPtr^);
  145.       { myLongwordPtr now points to the first QD global }
  146.     screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
  147.       { screenBitsPtr now points to the screenBits BitMap }
  148.     GetScreenBitsBounds := screenBitsPtr^.bounds;
  149.   END;
  150.  
  151.   PROCEDURE DoStandardFile(VAR reply: SFReply);
  152.   VAR where : Point;
  153.       typeList : SFTypeList;
  154.       dlgt: DialogTHndl;
  155.       r: rect;
  156.       screen: rect;
  157.       h,v: INTEGER;
  158.   BEGIN  { select text file to read using SFGetFile }
  159.     dlgt := DialogTHndl(GetResource('DLOG',getDlgID));
  160.     IF dlgt = nil THEN SetPt(where,82,75)
  161.     ELSE
  162.       BEGIN
  163.         r := dlgt^^.boundsRect;
  164.         screen := GetScreenBitsBounds;
  165.         h := ((screen.right - screen.left) - (r.right - r.left)) DIV 2;
  166.         v := ((screen.bottom - screen.top) - (r.bottom - r.top)) DIV 2;
  167.         SetPt(where,h,v);
  168.       END;
  169.     SFGetFile(where,'',NIL,-1,typeList,NIL,reply);
  170.   END;
  171.   
  172.   PROCEDURE WritePermission(paramPtr: XCMDPtr);
  173.   LABEL 8,9;
  174.   VAR err: OSErr;
  175.       reply: SFReply;
  176.       fRefNum: INTEGER;
  177.       fcbParams: FCBPBRec;
  178.       hParamBlock: HParamBlockRec;
  179.       volAttrib: INTEGER;
  180.       fileAttrib: SignedByte;
  181.       closeErr: INTEGER;
  182.       str: Str255;
  183.       canWrite: BOOLEAN;
  184.   BEGIN
  185.     IF paramPtr^.paramCount = 0 THEN DoStandardFile(reply)
  186.     ELSE
  187.       BEGIN
  188.         ZeroToPas(paramPtr,paramPtr^.params[1]^,str);
  189.         IF str = '' THEN DoStandardFile(reply)
  190.         ELSE WITH reply DO
  191.           BEGIN
  192.             good := TRUE;
  193.             vRefNum := 0;
  194.             fName := str;
  195.           END;
  196.       END;
  197.     IF NOT reply.good THEN
  198.       BEGIN
  199.         paramPtr^.returnValue := PasToZero(paramPtr,'Cancel');
  200.         EXIT(WritePermission);
  201.       END;
  202.     
  203.     canWrite := FALSE;                                   { assume failure }
  204.  
  205.     { Can the file be opened? }
  206.     WITH reply DO err := FSOpen(fName,vRefNum,fRefNum);
  207.     IF err <> noErr THEN GOTO 9;
  208.  
  209.     { Get the file control block info }
  210.     ZeroBytes(paramPtr,@fcbParams,SIZEOF(fcbParams));
  211.     fcbParams.ioRefNum := fRefNum;
  212.     fcbParams.ioNamePtr := @str;
  213.     err := PBGetFCBInfo(@fcbParams, FALSE);
  214.     IF err <> noErr THEN GOTO 8;
  215.  
  216.     { Get the volume info }
  217.     ZeroBytes(paramPtr,@hParamBlock,SIZEOF(hParamBlock));
  218.     hParamBlock.ioVRefNum := fcbParams.ioFCBVRefNum;
  219.     err := PBHGetVInfo(@hParamBlock,FALSE);
  220.     IF err <> noErr THEN GOTO 8;
  221.     volAttrib := hParamBlock.ioVAtrb;
  222.  
  223.     { Get the file info }
  224.     ZeroBytes(paramPtr,@hParamBlock,SIZEOF(hParamBlock));
  225.     hParamBlock.ioNamePtr := @str;
  226.     hParamBlock.ioVRefNum := fcbParams.ioFCBVRefNum;
  227.     hParamBlock.ioDirID := fcbParams.ioFCBParID;
  228.     err := PBHGetFInfo(@hParamBlock,FALSE);
  229.     IF err <> noErr THEN GOTO 8;
  230.     fileAttrib := hParamBlock.ioFlAttrib;
  231.  
  232. { We have write permission for this file if:
  233.    bit 0 of the ioFCBFlags field of the FCB record is set (IM IV-180),
  234.    the volume on which the file resides is not locked in hardware (IM IV-162,167),
  235.    the volume on which the file resides is not locked in software (IM IV-162,167),
  236.    and the file itself is not locked (IM IV-125). }
  237.  
  238.     canWrite := BTST(fcbParams.ioFCBFlags,8) &
  239.                                           { fcb thinks writing is allowed }
  240.                 NOT BTST(volAttrib,7) &   { volume not locked in hardware }
  241.                 NOT BTST(volAttrib,15) &  { volume not locked in software }
  242.                 NOT BTST(fileAttrib,0);                 { file not locked }
  243.  
  244.     IF paramPtr^.paramCount > 1 THEN
  245.       BEGIN     { if parameter 2 is TRUE, we check the resource fork also }
  246.         ZeroToPas(paramPtr,paramPtr^.params[2]^,str);
  247.         IF StrToBool(paramPtr,str)
  248.         THEN canWrite := canWrite & NOT BTST(fileAttrib,2); { (IM IV-125) }
  249.       END;
  250.  
  251. 8:  closeErr := FSClose(fRefNum);
  252.     canWrite := canWrite & (closeErr = noErr);
  253.  
  254. 9:  BoolToStr(paramPtr,canWrite,str); 
  255.     paramPtr^.returnValue := PasToZero(paramPtr,str);
  256.   END;
  257.  
  258. END.